home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor2
/
gausselm.src
< prev
next >
Wrap
Text File
|
1992-01-11
|
2KB
|
127 lines
%%HP: T(3)A(R)F(.);
@ GAUSSELM by Robert Brunner
DIR
QR
\<< TRN CONJ DCMP
OVER DUP 2 \->LIST 0
CON { } \-> a n m r q
\<< a 1 GET DUP
DUP ABS / DUP ROT
DOT 'r' { 1 1 } ROT
PUT 'q' SWAP STO+ 2
n
FOR i a i
GET DUP \-> ai
\<< 1 i 1 -
FOR j
DUP q j GET DUP ai
DOT 'r' { j i } ROT
PUT DUP ROT DOT * -
NEXT
DUP ABS / DUP ai
DOT 'r' { i i } ROT
PUT 'q' SWAP STO+
\>>
NEXT q RCMP
TRN CONJ r
\>>
\>>
LU
\<< DCMP OVER IDN
DUP 0 CON DCMP
DROP2 SWAP DCMP
DROP2 1 DUP DUP
RCLF \-> a m n l p pr
pc sr flg
\<<
WHILE pr m
< pc n \<= AND
REPEAT 1 CF
WHILE 1
FC? pc n \<= AND
REPEAT pr
'sr' STO
WHILE 1
FC? sr m \<= AND
REPEAT
IF a
sr GET pc GET
THEN
1 SF
ELSE
'sr' INCR DROP
END
END
IF 1
FC?
THEN
'pc' INCR DROP
END
END
IF 1 FS?
THEN
IF pr
sr \=/
THEN
'p' pr sr SWRW 'l'
pr sr SWRW 'a' pr
sr SWRW
END a
pr GET DUP pc GET \->
pivr piv
\<< pr 1
+ m
FOR i
a i GET DUP pc GET
piv / DUP l i GET
pr ROT PUT 'l' i
ROT PUT pivr * -
'a' i ROT PUT
NEXT
\>>
END 'pr'
INCR 'pc' INCR
DROP2
END p RCMP
l RCMP m IDN + a
RCMP flg STOF
\>>
\>>
DCMP
\<< OBJ\-> OBJ\->
DROP DUP2 * OVER 1
- \-> m n mn n1
\<< 1 m
FOR i n
\->ARRY mn n1 i * -
ROLLD
NEXT m
\->LIST m n
\>>
\>>
RCMP
\<< OBJ\-> OVER
SIZE OBJ\-> DROP OVER
\-> m n st
\<< 1 m
START OBJ\->
DROP 'st' n 1 -
STO+ st ROLL
NEXT 1 n 1
-
START st
ROLL
NEXT { m n
} \->ARRY
\>>
\>>
SWRW
\<< \-> i j
\<< DUP i GET
SWAP DUP DUP j GET
i SWAP PUT j ROT
PUT
\>>
\>>
END